
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Types
import Simulator
import Learner
import ManagementStore
import Constants
import Random
import Management

import System(getArgs)
import System.Console.GetOpt
import System.IO
import System.IO.Error
import System.Exit
import System.CPUTime
import System.Directory

import qualified Data.ByteString.Lazy as B
import Data.Binary
import qualified Data.Map as Map
import Data.Maybe
import Data.Array.Vector
import Data.Time.Clock
import Data.Time.Calendar

import Statistics.RandomVariate as RV

import Control.Monad.ST

{-
- options shamelessly stolen from getOpt manual
-}



options :: [OptDescr (Options -> Options)]
options =
     [ Option ['v'] ["verbose"]
       (NoArg (\ opts -> opts { optVerbose = True }))
       "chatty output on stderr - not implemented"
     , Option ['V','?'] ["version"]
       (NoArg (\ opts -> opts { optShowVersion = True }))
       "show version number - not implemented"
     , Option ['t'] ["test"]
       (NoArg (\ opts -> opts { optTestMain = True }))
       "run testMain for a single step - for testing"
     , Option ['y'] ["yield-curves"]
       (ReqArg (\ f opts -> opts { optYieldCurves =  Just $ read f  }) "INT")
       "include yield curve output"
     , Option ['f'] ["load-checkpoint"]
       (ReqArg (\ f opts -> opts { optLoadCheckpoint = Just  f })
        "FILE")
       "load-checkpoint FILE"
     , Option ['s'] ["stop-at"]
       (ReqArg (\ f opts -> opts { optStopAt = Just $ read f })
        "INT")
       "stop-at INT"
     , Option ['o'] ["output"]
       (ReqArg (\ f opts -> opts { optOutput = Just  f })
        "DIR")
       "output DIR - output directory"
     ]

lsOpts :: [String] -> IO (Options, [String])
lsOpts argv =
    case getOpt Permute options argv of
          (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)
          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
    where header = "Usage: main [OPTION...]"

main :: IO ()
main = do hSetBuffering stdout NoBuffering -- remove buffering for tee and diagnostics
          hSetBuffering stdin NoBuffering
          args <- getArgs
          (o,s) <- lsOpts args
          if optTestMain o
           then do testMain
                   exitWith ExitSuccess
           else return ()
          tempname <- tn
          let o' = o { optOutput = Just $ maybe tempname id (optOutput o) }
          createDirectoryIfMissing True $ fromJust $ optOutput o'
          (g,n,start,ss) <- if isJust $ optLoadCheckpoint o'
                            then readCheckPoint $ fromJust $ optLoadCheckpoint o'
                            else return startState
          res <- manyWorlds g o' n checkPointFrequency cleanupFrequency start ss
          return ()
    where initsg ss = do g <- RV.initialize (singletonU ss)
                         RV.save g
          buildSeeds = map (\s -> runST (initsg s)) prngSeeds
          startSims = [ testSim {simid = n} | n <- [1..parallelStreams] ]
          startState = (take parallelStreams buildSeeds,1,testSim,startSims)
          tn = do t <- getCurrentTime 
                  return $ "run-" ++ (show $ utctDay t) ++ "-" ++ (show $ utctDayTime t)


testMain = do let ss = runST go
              putStrLn (bsummary 1 ss)
              putStrLn (accSummary 1 $ world ss)
           where go = do g <- RV.initialize (singletonU $ head prngSeeds)
                         (runWorldSim g True testSim)

-- main = mutateTest2

mutateTest =  do args <- getArgs
                 let prngs = read (args !! 0)
                 let go = do g <- RV.initialize (singletonU prngs)
                             mutateManyTest g testMutator testManagement 1
                 putStrLn (show (runST go))

mutateTest2 = do args <- getArgs
                 let prngs = read (args !! 0)
                 let go = do g <- RV.initialize (singletonU prngs)
                             alternateSelection g testMutator (PNP PNullPolicy)  []
                 putStrLn (show (runST go))


-- CheckPoint ...
-- Data format is:
--  "LoanSimCheckpoint", typesVersion, rngState, SimState


-- DATA FOR TESTING

-- newStdGen -- makes a new Std RNG 

testPolicyLoan = 
    (PIf (PNumTest PRate PGT (PNum $0.09 * rateScale))
         (PIf (PNumTest PCapitalRat PGT (PNum $0.4 * capScale))
              (PIf (PNumTest PBankCash PGT PPrincipal)
                   (PNumTest PLiqRat PGT (PNum $0.5 * liqScale)) -- keep a min liq assets of 15%
                   PReject)
              PReject)
         PReject)

testPolicyDep = 
    (PIf (PNumTest PRate PLT (PNum $0.02 * rateScale))
         PAccept
         PReject)

testMgtRegs = (take managementPolicyRegisters (concat (repeat [PAccept,PReject])))

testManagement = SimpleM PAccept PAccept (PNum 0.1) testMgtRegs
simManagement = SimpleM testPolicyDep testPolicyLoan (PNum 0.01) testMgtRegs

testMutator = Mut (NormalPD 0 0.01) (UniformPD 0.00 1.0) 

--
-- NOTE - the fail penalty element ***MUST BE*** negative - this allows the insolvency checker to pick
--  up institution failure - TODO - get rid of this "feature"
--
-- (dateFloat ((D 20 0) `minusDate` d))
-- this is a little building-society-like institution.  Holds 5 securitized mortgages,
-- a wodge of cash (precisely equal to amount of equity) and a quantity of deposits



testBank = B { management=simManagement,
               bankcash=startCash,
               assets=(valBL startBonds,startBonds) ,
               liabilities=(0,[]) ,
               deposits=valBL startBonds,
               depositRate=0.00 ,
               regulatorControl=False ,
               dividends=[],
               profit=[] ,
               costs = 0,
               accounts = Map.empty,
               bankID = 0,
               failTime=0, 
               failPenalty=(-0.5) } -- per year of insolvency

testBond = Bond { start = zeroDate,
                  maturity = (D (4,0)),
                  rate = 0.07,
                  principal = (10.0),
                  rdefault = 0.01,
                  recovery = 0.5 }


{-

Basel II Requirements:

Cap requirement; Def risk (est)

0% - 0% - Govvies
1.6% - 0.25% - Bank - AAA-AA
4% - 0.5% - Resi-Mortgage - A
8% - 1% - Corporate Debt - BBB 
16% - 2% - e.g. Credit Card - B-BB

All debt is BBB for the time being

-}

-- Note default is ignored for liabilities 
testFactoryD1 = BondCF { defaultDist = (ConstantPD 0.01),
                         principalDist = prinD,
                         rateStep = rateStepDepositor,
                         rateStart = rateStartDepositor,
                         durationDist = IntRoundPD (UniformPD 1 5),
                         recoveryDist = (ConstantPD 0.5) }

testFactoryD2 = BondCF { defaultDist = (ConstantPD 0.01),
                         principalDist = prinD,
                         rateStep = rateStepDepositor,
                         rateStart = rateStartDepositor,
                         durationDist = IntRoundPD (UniformPD 1 10),
                         recoveryDist = (ConstantPD 0.5) }

-- All debt is BBB

testFactoryB1 = BondCF { defaultDist = (NormalPD 0.01 0.005),
                         principalDist = prinD,
                         rateStep = rateStepBorrower,
                         rateStart = rateStartBorrower,
                         durationDist = IntRoundPD (UniformPD 1 5),
                         recoveryDist = (ConstantPD 0.6) }

testFactoryB2 = BondCF { defaultDist = (NormalPD 0.01 0.005),
                         principalDist = prinD,
                         rateStep = rateStepBorrower,
                         rateStart = rateStartBorrower,
                         durationDist = IntRoundPD (UniformPD 1 10),
                         recoveryDist = (ConstantPD 0.6) }

-- regulator is a big softie 

testRegulator = R 0.03 0.04

testWorld = W { date = zeroDate,
                cashRateParams = (0.03,0,0), -- placeholder for now
                banks = [testBank],
                depositors = take 120 (repeat testFactoryD1),
                borrowers = take 120 (repeat testFactoryB1),
                regulator = testRegulator,
		diagnostic = []}


-- distribution of amount of cash
prinD = (UniformPD 25 50)
rateStepDepositor = (UniformPD (-0.025) (-0.015))
rateStepBorrower = (UniformPD 0.015 0.025)
rateStartDepositor = (ConstantPD 0.12)
rateStartBorrower = (ConstantPD (-0.02))
startBonds = [testBond {maturity = (D (y,m)),principal=10}| y <- [0],m <- [0..11] ]
startCash = 100::Cash

simWorld = W { date = zeroDate,
               cashRateParams = (0.03,0.005,4.0), -- placeholder for now
               banks = [testBank {bankID = id} | id <- [1..32]],
               depositors = (take 100 (repeat testFactoryD2)) ++
                            (take 100 (repeat testFactoryD1)),
               borrowers = (take 100 (repeat testFactoryB1)) ++
                            (take 100 (repeat testFactoryB2)),
               regulator = testRegulator,
	       diagnostic = [] }

-- BOUND should be equal to #banks / 2
-- TODO - change this so bound is a meaningful parameter - we should take bound and then repeatedly
-- generate enough from random members of bound for enough banks.


testSim = Sim { steps = 1500,
                bound = 16,
                worldsteps = 20 * miy,
                mutator = testMutator,
                mgt = addList (ManagementStore.empty 500) 
                      (take 40 (repeat (0.0,testManagement))),
                world = simWorld,
                keepAccounts = False,
                simid = 0}
